Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Pascal/Snippets/ColorIcosahedron 1.0/ColorIcosahedron.p

Text File | 1995-10-26 | 25.5 KB | 1,064 lines | [TEXT/PJMM]

program Univ_of_Utah (INPUT, OUTPUT);

{            Icosahedron display program               }
{ (c) Copyright 1986 University of Utah Computer Center, }
{      Written by John B. Halleck (NSS 20620)          }

{Ken Long digged it up and made it run again 1994.}
{Modernized by Ingemar R 1995 (grayscales rather than patterns,}
{color palette, delays, GWorlds).}
{}
{The program is *not* completely useable under MetroWerks Pascal, but the most}
{important parts (uses, initialization) are included.}
{}
{Second color version, 26 oct -95: The first had a few flaws that made it work poorly}
{under some systems. This version is a bit more careful in the port setting, which seems}
{to help.}

    uses
 {$IFC UNDEFINED THINK_PASCAL}
        MemTypes, QuickDraw, OSUtils, ToolUtils, Windows, Fonts, Menus, TextEdit, {}
        Dialogs, Memory,
{$ENDC}
        Palettes, OffscreenToysUtils;

    const
        kFullHeight = 128;    { How big is our screen image? }
        kHalfHeight = 64;    { Height of half of a screen image }
        kByteHeight = 16;    { kFullHeight covered divide 8}

        PI = 3.141592653;  { Pi }

        kNumVertices = 12; { Vertices in an Icosahedron }
        kNumFaces = 20; { faces in an Icosahedron    }
        kNumEdges = 30; { edges in an Icosahedron    }

        kNumViews = 20; { Rotation in how many steps?}


    type
        Transform = array[1..3, 1..3] of Real; { Transformation matrices }

        Coordinates = array[1..3] of Real; { 3 space coordinates. }

        View = packed array[1..kFullHeight, 1..kByteHeight] of 0..255;
         { Storage for the views. }

        Apoint = record { Information we keep for each point   }
                DX, DY: Integer;     { Display Coordinates.  }
                Where: Coordinates; { Original Coordinates. }
                NowAt: Coordinates; { Final Coordinates.    }
            end;

        AnEdge = record { Information for each edge }
                Visible: Boolean; { Is the edge visible?        }
                Start, Finish: Integer; { Which vertices does it connect? }
            end;

        Aface = record { Information about each face }
                Bedges: array[1..3] of integer; { What bounding edges    }
                BVert: array[1..3] of integer; { What corner vertices   }
                ONormal: Coordinates;             { Original Surface Normal}
                Normal: Coordinates;             { Final Surface Normal   }
                Shows: Boolean;           {Is it visible?          }
            end;

    var

        index: Integer; { General loop index}

   { How does the Icosahedron connect together? }
        Vertices: array[1..kNumVertices] of Apoint;
        edges: array[1..kNumEdges] of AnEdge;
        faces: array[1..kNumFaces] of Aface;

        light: Coordinates; {Where is the light source?}

        patterns: array[0..64] of Pattern; {Brightness patterns for shading}
        cpatterns: array[0..64] of RGBColor; {Brightness colors for shading}

        ImageTransform: Transform;  { How to get to our viewing point. }
        RotationTransform: Transform;  { How far we have rotated it.      }
        TotalTransform: Transform;  { Composition of the above.        }

        ourBitMaps: array[1..kNumViews] of GrafPtr; { Storage for the frames }

        systemGrafPtr: GrafPtr; { Where is TML pascal's window? }
        limits: Rect;       { Boundrys of the window, more or less }

        Fifth: Real;  { Fractions of a complete circle }
        Tenth: Real;

        Axis_X: Real; { Axis of rotation that we should rotate around. }
        Axis_Y: Real;
        Axis_Z: Real;

        icoWindow: WindowPtr;
        icoArea: Rect;
        ticks: longint;

{ ******************************************************************** }

{ Identity rotation matrix }

    procedure IdentTransform (var Atransform: Transform);
        var
            Row, Column: Integer;
    begin
        for Row := 1 to 3 do
            for Column := 1 to 3 do
                Atransform[Row, Column] := 0.0;
        for Row := 1 to 3 do
            Atransform[Row, Row] := 1.0
    end;


{ ******************************************************************** }

{ Form rotation matrices }

{ Rotation matrices for rotation around }
{    X                 Y                  Z }

{   1   0   0        C   0   S        C   S   0   }
{   0   C   S        0   1   0       -S   C   0   }
{   0  -S   C       -S   0   C        0   0   1   }

{ Where C= COS (Angle)   and   S= SIN (angle) }

{ Around 1 means around X, 2 means around Y, and 3 means around Z}


    procedure FormRot (Angle: Real; Around: Integer; var Result: Transform);
        var
            S, C: Real;
            Left, Right: Integer; { The lower and upper row and column to fill }
    begin
        IdentTransform(Result);
        S := SIN(Angle);
        C := COS(Angle);
        case Around of
            1:
                begin
                    Left := 2;
                    Right := 3
                end;
            2:
                begin
                    Left := 1;
                    Right := 3
                end;
            3:
                begin
                    Left := 1;
                    Right := 2
                end;
        end;
        Result[Left, Left] := C;
        Result[Left, Right] := S;
        Result[Right, Left] := -S;
        Result[Right, Right] := C;
    end;

{ ******************************************************************** }


{ Multiply two transformation matricies together forming a third }

    procedure TTransform (First, Second: Transform; var Result: Transform);
        var
            Row, Column: integer;
    begin
        for Row := 1 to 3 do
            for Column := 1 to 3 do
                Result[Row, Column] := First[Row, 1] * Second[1, Column] + First[Row, 2] * Second[2, Column] + First[Row, 3] * Second[3, Column]
    end;



{ ******************************************************************** }

{ Add the effect of doing a given rotation onto a transformation matrix }

    procedure AddRot (Angle: Real; Around: Integer; var Result: Transform);
        var
            Temp, Final: Transform;
    begin
        FormRot(Angle, Around, Temp);
        TTransform(Result, Temp, Final);
        Result := Final
    end;
{ ******************************************************************** }


{ Transform a point by the Total transformation matrix. }

    procedure TPoint (What: Coordinates; var Into: Coordinates);
        var
            Dimension: Integer;
    begin
        for Dimension := 1 to 3 do
            Into[Dimension] := What[1] * TotalTransform[1, Dimension] + What[2] * TotalTransform[2, Dimension] + What[3] * TotalTransform[3, Dimension]
    end;

{ ******************************************************************** }

{ Assuming the point given discribes a vector from the origin, produce }
{ a point that discribes a unit length vector from the origin.}

    procedure Normalize (var ThePoint: Coordinates);
        var
            Length: Real;
    begin
        Length := SQRT(ThePoint[1] * ThePoint[1] + ThePoint[2] * ThePoint[2] + ThePoint[3] * ThePoint[3]);
        ThePoint[1] := ThePoint[1] / Length;
        ThePoint[2] := ThePoint[2] / Length;
        ThePoint[3] := ThePoint[3] / Length
    end;


{ ******************************************************************** }

    procedure INITIALIZE;

        var
            edges_So_Far: Integer;

        procedure INITPOINTS; { Where are the coordinates of an icosahedron? }
{ (Icosahedron with unit edges, with center at the origin) }
        begin
            with Vertices[1] do
                begin
                    Where[1] := 0.00000000;
                    Where[3] := 0.00000000;
                    Where[2] := -0.95105650
                end;
            with Vertices[2] do
                begin
                    Where[1] := 0.00000000;
                    Where[3] := 0.85065080;
                    Where[2] := -0.42532537
                end;
            with Vertices[3] do
                begin
                    Where[1] := 0.80901699;
                    Where[3] := 0.26286555;
                    Where[2] := -0.42532537
                end;
            with Vertices[4] do
                begin
                    Where[1] := 0.49999999;
                    Where[3] := -0.68819096;
                    Where[2] := -0.42532537
                end;
            with Vertices[5] do
                begin
                    Where[1] := -0.50000001;
                    Where[3] := -0.68819094;
                    Where[2] := -0.42532537
                end;
            with Vertices[6] do
                begin
                    Where[1] := -0.80901698;
                    Where[3] := 0.26286557;
                    Where[2] := -0.42532537
                end;
            with Vertices[7] do
                begin
                    Where[1] := 0.49999999;
                    Where[3] := 0.68819095;
                    Where[2] := 0.42532537
                end;
            with Vertices[8] do
                begin
                    Where[1] := 0.80901699;
                    Where[3] := -0.26286556;
                    Where[2] := 0.42532537
                end;
            with Vertices[9] do
                begin
                    Where[1] := 0.00000000;
                    Where[3] := -0.85065080;
                    Where[2] := 0.42532537
                end;
            with Vertices[10] do
                begin
                    Where[1] := -0.80901699;
                    Where[3] := -0.26286555;
                    Where[2] := 0.42532537
                end;
            with Vertices[11] do
                begin
                    Where[1] := -0.50000001;
                    Where[3] := 0.68819094;
                    Where[2] := 0.42532537
                end;
            with Vertices[12] do
                begin
                    Where[1] := 0.00000000;
                    Where[3] := 0.00000000;
                    Where[2] := 0.95105650
                end
        end;



        procedure INITfaces; { How are those vertices connected? }
        begin
            with faces[1] do
                begin
                    Bvert[1] := 1;
                    Bvert[2] := 3;
                    Bvert[3] := 2
                end;
            with faces[2] do
                begin
                    Bvert[1] := 1;
                    Bvert[2] := 4;
                    Bvert[3] := 3
                end;
            with faces[3] do
                begin
                    Bvert[1] := 1;
                    Bvert[2] := 5;
                    Bvert[3] := 4
                end;
            with faces[4] do
                begin
                    Bvert[1] := 1;
                    Bvert[2] := 6;
                    Bvert[3] := 5
                end;
            with faces[5] do
                begin
                    Bvert[1] := 1;
                    Bvert[2] := 2;
                    Bvert[3] := 6
                end;
            with faces[6] do
                begin
                    Bvert[1] := 2;
                    Bvert[2] := 7;
                    Bvert[3] := 11
                end;
            with faces[7] do
                begin
                    Bvert[1] := 2;
                    Bvert[2] := 3;
                    Bvert[3] := 7
                end;
            with faces[8] do
                begin
                    Bvert[1] := 3;
                    Bvert[2] := 8;
                    Bvert[3] := 7
                end;
            with faces[9] do
                begin
                    Bvert[1] := 3;
                    Bvert[2] := 4;
                    Bvert[3] := 8
                end;
            with faces[10] do
                begin
                    Bvert[1] := 4;
                    Bvert[2] := 9;
                    Bvert[3] := 8
                end;
            with faces[11] do
                begin
                    Bvert[1] := 4;
                    Bvert[2] := 5;
                    Bvert[3] := 9
                end;
            with faces[12] do
                begin
                    Bvert[1] := 5;
                    Bvert[2] := 10;
                    Bvert[3] := 9
                end;
            with faces[13] do
                begin
                    Bvert[1] := 5;
                    Bvert[2] := 6;
                    Bvert[3] := 10
                end;
            with faces[14] do
                begin
                    Bvert[1] := 6;
                    Bvert[2] := 11;
                    Bvert[3] := 10
                end;
            with faces[15] do
                begin
                    Bvert[1] := 6;
                    Bvert[2] := 2;
                    Bvert[3] := 11
                end;
            with faces[16] do
                begin
                    Bvert[1] := 11;
                    Bvert[2] := 7;
                    Bvert[3] := 12
                end;
            with faces[17] do
                begin
                    Bvert[1] := 7;
                    Bvert[2] := 8;
                    Bvert[3] := 12
                end;
            with faces[18] do
                begin
                    Bvert[1] := 8;
                    Bvert[2] := 9;
                    Bvert[3] := 12
                end;
            with faces[19] do
                begin
                    Bvert[1] := 9;
                    Bvert[2] := 10;
                    Bvert[3] := 12
                end;
            with faces[20] do
                begin
                    Bvert[1] := 10;
                    Bvert[2] := 11;
                    Bvert[3] := 12
                end;
        end;


        procedure INITnormals;
{ A normal vector to a face is a vector perpendicular to the face }
{ In this case, defined to point outwards. }
            var
                ThisFace: Integer;

      { One could compute the normal from the three edge vertices, and }
    { in general this is correct.      But, since the Icosahedron is }
    { defined around the origin, the normal is in the direction of   }
    { the average of the directions to the vertices }
            procedure FindNormal (Vertex1, Vertex2, Vertex3: Integer; var Norm: Coordinates);
                var
                    index: Integer;
            begin
      { Find the average of the vertices }
                for index := 1 to 3 do
                    Norm[index] := (Vertices[Vertex1].Where[index] + Vertices[Vertex2].Where[index] + Vertices[Vertex3].Where[index]) / 3.0;
      { Make it a unit normal }
                Normalize(Norm)
            end;
        begin
{ For each face, find the surface normal }
            for ThisFace := 1 to kNumFaces do
                with faces[ThisFace] do
                    FindNormal(Bvert[1], Bvert[2], Bvert[3], ONormal)
        end;



        procedure INITedges; { Given the face information, derive the edges }
            var
                ThisFace: Integer;

     { IF an edge is not in the table, add it. }
            function ADDedge (Vertex1, Vertex2: Integer): Integer;
                var
                    First, Second: Integer;
                    ThisEdge: Integer;
                    Found: Boolean;
            begin
     { Put edge in standard order }
                if Vertex1 < Vertex2 then
                    begin
                        First := Vertex1;
                        Second := Vertex2
                    end
                else
                    begin
                        First := Vertex2;
                        Second := Vertex1
                    end;

     { Search the table for it }
                ThisEdge := 0;
                Found := False;
                repeat
                    ThisEdge := ThisEdge + 1;
                    if ThisEdge <= edges_so_far then
                        with edges[ThisEdge] do
                            Found := (First = Start) and (Second = Finish);
                until (ThisEdge >= edges_so_far) or FOUND;

     { If we don't have one, add it on. }
                if not Found then
                    begin
                        edges_So_far := edges_So_far + 1;
                        ThisEdge := edges_So_far;
                        with edges[ThisEdge] do
                            begin
                                Start := First;
                                Finish := Second
                            end
                    end;

     { Return an index to it.}
                AddEdge := ThisEdge
            end;

        begin
            edges_So_Far := 0;

{ For each face, add its edges to the list }
            for ThisFace := 1 to kNumFaces do
                with faces[ThisFace] do
                    begin
                        Bedges[1] := AddEdge(Bvert[1], Bvert[2]);
                        Bedges[2] := AddEdge(Bvert[2], Bvert[3]);
                        Bedges[3] := AddEdge(Bvert[1], Bvert[3])
                    end;
        end;



{ Come up with some shading patterns. }

        procedure InitPat;
            var
                Row, Column, Entry, Sample: integer;
                Loc, Temp, Size: Integer;
                TwoToThe: array[0..7] of 0..255;
            function MakeRGB (r, g, b: Integer): RGBColor;
            begin
                MakeRGB.red := r;
                MakeRGB.green := g;
                MakeRGB.blue := b;
            end; {MakeRGB}
        begin

            if gColorQDFlag then
                begin
                    for entry := 0 to 64 do
                        cpatterns[entry] := MakeRGB(BSL(entry, 9), BSL(entry, 9), BSL(entry, 9));
                    Exit(InitPat);
                end;

{ Initialize a table of powers of 2 }
            Sample := 1;
            for Temp := 0 to 7 do
                begin
                    TwoToThe[Temp] := Sample;
                    Sample := Sample + Sample
                end;

{ Start shading patterns Black }
            for Entry := 0 to 64 do
                for Row := 0 to 7 do
                    patterns[Entry][Row] := 0;

{ Place dots in as evenly as practical }
{ The Macintosh has the convention that a bit =1 is black, and a }
{ a bit = 0 is white. }
            for Entry := 63 downto 0 do
                begin
                    Loc := Entry;
                    Row := 0;
                    Column := 0;
                    Size := 8;
                    for Temp := 1 to 3 do
                        begin
                            Row := Row + Row;
                            Column := Column + Column;
                            case Loc mod 4 of
           { Dither matrix recursively applied: }
           { 0 3 }
           { 2 1 }
                                0:
                                    ;
                                1:
                                    begin
                                        Row := Row + 1;
                                        Column := Column + 1
                                    end;
                                2:
                                    Row := Row + 1;
                                3:
                                    Column := Column + 1;
                            end;
                            Loc := Loc div 4
                        end;
                    Sample := TwoToThe[Column];
                    for Temp := Entry downto 0 do
                        patterns[Temp][Row] := patterns[Temp][Row] + Sample
                end
        end; {InitPat}



{ Start out with no transformations }
        procedure InitTransforms;
        begin
            IdentTransform(TotalTransform);
            IdentTransform(RotationTransform);
            IdentTransform(ImageTransform);
        end;

{ Get memory for the frames }
        procedure InitFrames;
            var
                index: Integer;
        begin
{ Obtain and Initialize frame records }
            for index := 1 to kNumViews do
                OTNewGWorld(ourBitMaps[index], limits);
        end; {InitFrames}

{ What axis should this thing seem to rotate around? }
        procedure InitAxis;
        begin
{ The direction }
            Axis_X := -Tenth;
            Axis_Y := 0.0;
            Axis_Z := Tenth;

{ Matrix to get us there }
            FormRot(Axis_X, 1, ImageTransform);
            AddRot(Axis_Y, 2, ImageTransform);
            AddRot(Axis_Z, 3, ImageTransform);
        end;

        procedure InitLight; { Set up the light source }
{ Shading is going to be Cosine shading.  Brightness is proportional to }
{ the cosine of the angle between Bright vector and the Eye.  Bright    }
{ Vector is the direction of the bright spot on the object, which is    }
{ Half way between the Eye and the light. }

            var
                Eye: Coordinates; { Direction to the Eye }
        begin

{ Intended direction of light}
            light[1] := 3.0;
            light[2] := -1.0;
            light[3] := 1.0;
            Normalize(light); { Unit directions only. }

{ Direction of Eye. Forced by physical model, Don't Change this. }
            Eye[1] := 0.0;
            Eye[2] := 0.0;
            Eye[3] := 1.0;
            Normalize(Eye);

{ Average of unit vector to the eye and the light }
            light[1] := (light[1] + Eye[1]) / 2.0;
            light[2] := (light[2] + Eye[2]) / 2.0;
            light[3] := (light[3] + Eye[3]) / 2.0;
            Normalize(light)      { Make it a unit direction}
        end;




    begin { Get everything we need }
        Fifth := (2 * PI) / 5.0;
        Tenth := PI / 5.0;
        GetPort(systemGrafPtr);
{systemBitMap := systemGrafPtr^.PortBits;}
        SetRect(limits, 0, 0, kFullHeight, kFullHeight);
        INITPOINTS;
        INITfaces;
        InitNormals;
        INITedges;
        InitPat;
        InitTransforms;
        InitFrames;
        InitAxis;
        InitLight
    end;


{ ******************************************************************** }

{ Find the visible faces and edges }

    procedure FindVisible;
        var
            ThisFace: Integer;
            ThisEdge: Integer;
    begin
        for ThisEdge := 1 to kNumEdges do
            with edges[ThisEdge] do
                Visible := False;

{ For each face, if the face is visible, mark it and it's edges visible }
        for ThisFace := 1 to kNumFaces do
            with faces[ThisFace] do
                begin
   { Assuming that we have a CONVEX object, then the face pointing towards }
   { us means that it MUST be visible }
                    Shows := Normal[3] >= 0.0;
                    if Shows then
                        begin
                            edges[Bedges[1]].Visible := true;
                            edges[Bedges[2]].Visible := true;
                            edges[Bedges[3]].Visible := true
                        end
                end
    end;

{ ******************************************************************** }

{ Compute Display Coordinates for each point}
{ (with the current transformation) }

    procedure SetDisplay;
        var
            ThisPoint: Integer;
    begin
{ We assume that the Object is defined centered around the origin. }
        for ThisPoint := 1 to kNumVertices do
            with Vertices[ThisPoint] do
                begin
                    DX := ROUND((NowAt[1] + 1.0) * kHalfHeight);
                    DY := ROUND((NowAt[2] + 1.0) * kHalfHeight)
                end;
    end;

{ ******************************************************************** }

{ Glue code for drawing shades }

    procedure MyFillRgn (aRegion: RgnHandle; level: Integer);
    begin
        if aRegion = nil then
            Exit(MyFillRgn);
        if gColorQDFlag then
            begin
                RGBForeColor(cpatterns[level]);
                PaintRgn(aRegion);
                ForeColor(blackColor);
            end
        else
            FillRgn(aRegion, patterns[level]);
    end; {MyFillRgn}

    procedure MyFillRect (aRect: Rect; level: Integer);
    begin
        if gColorQDFlag then
            begin
                RGBForeColor(cpatterns[level]);
                PaintRect(aRect);
                ForeColor(blackColor);
            end
        else
            FillRect(aRect, patterns[level]);
    end; {MyFillRect}

    procedure MyBackPat (level: Integer);
    begin
        if gColorQDFlag then
            RGBBackColor(cpatterns[level])
        else
            BackPat(patterns[level]);
    end; {MyBackPat}

    procedure MyPenPat (level: Integer);
    begin
        if gColorQDFlag then
            RGBForeColor(cpatterns[level])
        else
            PenPat(patterns[level]);
    end; {MyPenPat}

{ ******************************************************************** }

{ Display the visible edges }

    procedure Drawedges;
        var
            ThisEdge: Integer;
    begin
        SetDisplay;
        for ThisEdge := 1 to kNumEdges do
            with edges[ThisEdge] do
                if Visible then
                    begin
                        with Vertices[Start] do
                            MoveTo(DX, DY);
                        with Vertices[Finish] do
                            LineTo(DX, DY)
                    end
    end;

{ ******************************************************************** }

{ Compute the brightnesses of the faces. }

    procedure Shadefaces;
        var
            ThisFace: Integer;
            aRegion: RgnHandle;
            Level: Integer;

        function Bright (PlaneNorm, LightNorm: Coordinates): Real;
        begin
    { Brightness should be proportional to the cosine of the angle }
    { between the face normal and the Bright spot.  The dot        }
    { product of the Normal and the Bright spot vectors would give }
    { Cosine angle * Length Bright * Length Face Normal,           }
    { But since we have arranged for both lengths to be 1, this    }
    { gives just Cosine Angle which is what we want.               }
            Bright := ((PlaneNorm[1] * LightNorm[1] + PlaneNorm[2] * LightNorm[2] + PlaneNorm[3] * LightNorm[3]) + 1.0) / 2.0
    { We scale the value to lie between 0 (Black) and 1 (White)    }
        end;
    begin
        aRegion := NewRgn;
{ For each visible face... }
        for ThisFace := 1 to kNumFaces do
            with faces[ThisFace] do
                if Shows then
                    begin

    { Form the region for the face for the MacIntosh primitives }
                        OpenRgn;
                        with Vertices[Bvert[3]] do
                            MoveTo(DX, DY);
                        with Vertices[Bvert[1]] do
                            LineTo(DX, DY);
                        with Vertices[Bvert[2]] do
                            LineTo(DX, DY);
                        with Vertices[Bvert[3]] do
                            Lineto(DX, DY);
                        CloseRgn(aRegion);

    { Fill with the computed brightness }
                        level := Round(Bright(Normal, light) * 64.0);
                        MyFillRgn(aRegion, level);
                        SetEmptyRgn(aRegion)
                    end;
        DisposeRgn(aRegion)
    end; {Shadefaces}

{ ******************************************************************** }


{ Transform the faces and vertices by the current transformation }

    procedure DoTransform;
        var
            ThisFace, ThisPoint: Integer;
    begin
        for ThisFace := 1 to kNumFaces do
            with faces[ThisFace] do
                TPoint(ONormal, Normal);
        for ThisPoint := 1 to kNumVertices do
            with Vertices[ThisPoint] do
                Tpoint(Where, NowAt)
    end;

{ ******************************************************************** }

{ Build the current transformation from its parts, apply the transform, }
{ and compute the visible faces and edges. }

    procedure SetupFrame;
    begin
        TTransform(RotationTransform, ImageTransform, TotalTransform);
        DoTransform;
        SetDisplay;
        FindVisible
    end;

{ ******************************************************************** }

{ Draw one frame }
    procedure OutFrame;
    begin
        SetupFrame;
        MyFillRect(limits, 0);
        Shadefaces;
        Drawedges
    end;

{ ******************************************************************** }

{ Draw the frames of the Object in each orientation. }

    procedure ComputeFrames;
        var
            index: Integer;
            This_Angle, Step_Angle: Real;
            savePort: GrafPtr;
            saveDev: GDHandle;
    begin
        Step_Angle := Fifth / kNumViews; { Assume 5 fold rotational symetry }
        OTGetGWorld(savePort, saveDev); {This should be the screen!}
{Let's make sure the window's colors are CopyBits-friendly!}
        ForeColor(blackColor);
        BackColor(whiteColor);
        for index := 1 to kNumViews do
            begin
                This_Angle := index * Step_Angle;
                FormRot(This_Angle, 2, RotationTransform);
                OTSetGWorld(ourBitMaps[index], nil);
{SetPortBits(ourBitMaps[index]);}
                OutFrame;
                OTSetGWorld(savePort, saveDev);
                CopyBits(ourBitMaps[index]^.portBits, systemGrafPtr^.PortBits, limits, limits, srcCopy, nil); {systemGrafPtr^.visRgn}
            end;
        OTSetGWorld(savePort, saveDev);
{SetPortBits(systemGrafPtr^.PortBits)}
    end; {ComputeFrames}


{ ******************************************************************** }

{ Thumb through the frames, copying each to the screen.  Change the }
{ Aiming point (and thumb direction ) to mimic bouncing }

    procedure Thumb;
        var
            index: Integer;
            dest: Rect;
            offset_X, direction_X: Integer;
            offset_Y, direction_Y: Integer;
            direction_Rot: Integer;
            bounce: Rect;
            startTicks: Longint;
    begin
        ForeColor(blackColor);
        BackColor(whiteColor);

        index := 0;
        direction_Rot := 1;
        offset_X := 0;
        direction_X := 1;
        offset_Y := 0;
        direction_Y := 1;
        SetOrigin(0, 0);

        bounce := systemGrafPtr^.portRect;
        bounce.right := bounce.right - kFullHeight;
        bounce.bottom := bounce.bottom - kFullHeight;
        dest := limits;

        while not Button do
            begin
                startTicks := TickCount;

{ Select frame, Force wrap if off ends of frame list. }
                index := index + direction_Rot;
                if index > kNumViews then
                    index := 1
                else if index < 1 then
                    index := kNumViews;

{ Copy this frame to screen }
                CopyBits(ourBitMaps[index]^.portBits, systemGrafPtr^.portBits, limits, dest, srcCopy, nil); {systemGrafPtr^.visRgn}

{ Update X, check for bounce }
                offset_X := offset_X + direction_X;
                if (offset_X > bounce.Right) or (offset_X < bounce.Left) then
                    begin
                        direction_X := -direction_X;
                        direction_Rot := direction_X * direction_Y;
                    end;

{ Update Y, check for bounce }
                offset_Y := offset_Y + direction_Y;
                if (offset_Y > bounce.Bottom) or (offset_Y < bounce.Top) then
                    begin
                        direction_Rot := direction_X * direction_Y;
                        direction_Y := -direction_Y;
                    end;

{ Update current location for transfer. }
                dest := limits;
                OffsetRect(dest, offset_X, offset_Y);

                while startTicks + 1 > TickCount do
                    ;
            end;

        while Button do { Nothing }
            ;
    end; {Thumb}

    procedure Get_New_Window;
    begin
        if gColorQDFlag then
            icoWindow := GetNewCWindow(128, nil, WindowPtr(-1))
        else
            icoWindow := GetNewWindow(128, nil, WindowPtr(-1));
        ShowWindow(icoWindow);
        SetPort(icoWindow);

        SetRect(icoArea, 0, 0, 475, 275);
    end; {Get_New_Window}

{Draw a string centered in the port}

    procedure CenterString (s: Str255; height: Integer);
    begin
        MoveTo((thePort^.portRect.right - thePort^.portRect.left - StringWidth(s)) div 2, height);
        DrawString(s);
    end; {CenterString}

{ ******************************************************************** }


begin
{$IFC UNDEFINED THINK_PASCAL}
    InitGraf(@qd.thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(nil);
    MaxApplZone;
{$ENDC}

    OTInitGlobals;

    Get_New_Window;
    HideCursor;
    CenterString('Icosahedron Version 0.6', 20);
    CenterString('(c) Copyright 1986 By the University of Utah Computer Center', 40);
    CenterString('Written by John Halleck  (NSS 20620)', 60);
    Delay(90, ticks);
    TextFace([bold]);
    CenterString('Brought back to life at itty bitty bytes™,', 90);
    CenterString(' 25 September 1994,', 110);
    CenterString('by Kenneth A. Long', 130);
    Delay(120, ticks);
    TextFace([bold]);
    ForeColor(redColor);
    CenterString('Even some more life (color, palettes) put into it,', 170);
    ForeColor(magentaColor);
    CenterString('plus some much needed delays,', 190);
    ForeColor(blueColor);
    CenterString('October 1995,', 210);
    ForeColor(greenColor);
    CenterString('by Ingemar R', 230);
    Delay(120, ticks);
    INITIALIZE;
{SetPort(systemGrafPtr);}
    for index := 64 downto 0 do
        begin
            MyFillRect(systemGrafPtr^.portRect, index);
            Delay(1, ticks);
        end;
    MyBackPat(0);
    SetupFrame;
    MyPenPat(64);
    Drawedges;
    MyPenPat(0);
    Shadefaces;
    Drawedges;
    ComputeFrames;
    Thumb;
    if gColorQDFlag then
        RestoreDeviceClut(nil);
    ShowCursor;
    FlushEvents(mDownMask, 0);
end.